2/************************************************
    3 *		  DISTANCE			*
    4 ************************************************/
    5
    6%%%%% NOTE: we only compute the intervals of the distance fluent in (Qi-WM,Qi]
    7%%%%% This is OK for the CAVIAR event description
    8%%%%% A proper treatment of this fluent additionally requires the computation
    9%%%%% of the last interval before (Qi-WM,Qi]
   10
   11preProcessing(QueryTime) :-
   12	findall((Id1,Id2,Threshold), 
   13		(
   14			iePList(Id1, distance(Id1,Id2,Threshold)=true, _, _), 
   15			retract(iePList(Id1, distance(Id1,Id2,Threshold)=true, _, _))), 
   16		_),
   17	% for each pair of tracked entities ...
   18	findall((Id1,Id2), (id_pair(Id1,Id2), aux1(Id1,Id2,QueryTime)), _).
   19
   20% ... compute their distance at each time-point
   21aux1(Id1, Id2, QueryTime) :-
   22	findall((T,Dist), h(distance(Id1,Id2,Dist)=true, T), DistList),
   23	% ... and for each known threshold value ... 	
   24	findall(Threshold, (threshold(_,Threshold), aux2(Threshold,DistList,QueryTime,Id1,Id2)), _).
   25
   26% ... compute the maximal intervals for which distance is less than the threshold 
   27aux2(Threshold, List, QueryTime, Id1, Id2) :-
   28	setof(T, member((T,Threshold),List), PointList), !,
   29	% below 40 represents the temporal distance between two consecutive time-points
   30	makeIntervalsFromAllPoints(PointList, 40, QueryTime, [], L),
   31	assert(iePList(Id1, distance(Id1,Id2,Threshold)=true, L, [])).
   32
   33% do not assert empty list of distance intervals
   34aux2(_Threshold, _List, _QueryTime, _Id1, _Id2).
   35
   36
   37
   38% Application-dependent threshold distances
   39% IMPORTANT: the facts below must be ordered by threshold and there should be no duplicates
   40
   41threshold(fight, 24).
   42threshold(interact, 25).
   43threshold(leave, 30).
   44threshold(meet_move, 34).
   45
   46
   47h(distance(Id1,Id2,Dist)=true, T) :-
   48	holdsAtIE(coord(Id1,X1,Y1)=true, T),
   49	holdsAtIE(coord(Id2,X2,Y2)=true, T),
   50	XDiff is abs(X1-X2),
   51	YDiff is abs(Y1-Y2),
   52	SideA is XDiff*XDiff,
   53	SideB is YDiff*YDiff,
   54	Temp is SideA+SideB,
   55	D is sqrt(Temp),
   56	compareWithDistanceThresholds(D, Dist).
   57
   58
   59compareWithDistanceThresholds(D, Threshold) :- 
   60	threshold(_, Threshold),  	
   61	D=<Threshold, !.
   62
   63% NOTE: if the distance between two tracked entities is greater than the highest threshold
   64% then we do not need to store it (the distance)